home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TIMING.SWG / 0016_Events on IRQ-TIMERS.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  13KB  |  280 lines
  1. {
  2. From: JAKE CHAPPLE
  3. Subj: Events on IRQ/TIMERS
  4. ---------------------------------------------------------------------------
  5. }
  6.  
  7. {----------------------- Beginning of TIMER.PAS -----------------------}
  8. Unit Timer;
  9.  
  10. {========================================================================}
  11. {                           INTERFACE SECTION                            }
  12. {========================================================================}
  13. {                                                                        }
  14. { This unit implements a set of general purpose, low resolution timers   }
  15. { for use in any application that requires them.  The design of the      }
  16. { timer system is adapted from the following magazine article:           }
  17. {                                                                        }
  18. {   Jones S., A High-Performance Lightweight Timer Package, Tech         }
  19. {      Specialist, Vol. 2, No. 1, Jan 1991, pp 17-27.                    }
  20. {                                                                        }
  21. { Most of Jones' design has been copied, although this implementation is }
  22. { in Turbo Pascal rather than MASM.  By default, this unit provides 10   }
  23. { timers, although this can be increased by increasing the value of      }
  24. { MAX_TIMER and re-compiling.                                            }
  25. {                                                                        }
  26. { Timers are referenced by "handles" i.e. small integers.  These are     }
  27. { actually indexes into the timer array.  To obtain a handle one must    }
  28. { ALLOCATE a timer.  The Allocate function also requires the address of  }
  29. { a routine to execute when the timer expires as well as a user context  }
  30. { variable.  The timer function must be compiled as a FAR routine.  The  }
  31. { user context variable is a 16 bit word of data that can be used for any}
  32. { application specific purpose.  It is passed to the timer routine when  }
  33. { the timer expires.  This is useful if a common timer routine is used   }
  34. { for multiple timers.  It allows the common timer routine to determine  }
  35. { which timer expired and take appropriate action.                       }
  36. {                                                                        }
  37. { Once a timer is allocated, it must be STARTED.  The StartTimer         }
  38. { procedure requires the timer handle and a timer running time.  The     }
  39. { timer running timer is passed as a RELATIVE number of MILLISECONDS i.e.}
  40. { the number of milliseconds from now when the timer should expire.      }
  41. {                                                                        }
  42. { A timer can be stopped before it expires with StopTimer which just     }
  43. { requires the timer handle.  There is the possibility that the StopTimer}
  44. { routine could be interrupted by a clock tick and the expiration routine}
  45. { could run before the StopTimer procedure actually stops the timer.     }
  46. { It's up to you to guard against this.                                  }
  47. {                                                                        }
  48. { Finally, an allocated timer can be deallocated with DeallocateTimer    }
  49. {========================================================================}
  50.  
  51. INTERFACE
  52.  
  53. uses
  54.     Dos;
  55.  
  56. type
  57.     UserProc = procedure(context : word);
  58.  
  59.  
  60. function  AllocateTimer(UserContext : word; UserRtn : UserProc) : integer;
  61. procedure StartTimer(handle : integer; rel_timeout : longint);
  62. procedure StopTimer(handle : integer);
  63. procedure DeallocateTimer(handle : integer);
  64.  
  65. {========================================================================}
  66. {                        IMPLEMENTATION SECTION                          }
  67. {========================================================================}
  68.  
  69. IMPLEMENTATION
  70.  
  71. const
  72.      MAX_TIMER = 10;            {Total number of timers}
  73.      MILLISECS_PER_TICK = 55;   {clock tick interval}
  74.      TIMER_ALLOCATED = 1;       {bits in the timer flags word}
  75.      TIMER_RUNNING   = 2;
  76.  
  77. type
  78.     timer_rec = record                  {Timer descriptor record}
  79.                   timeout : longint;    {Timeout.  Absolute number of millisecs}
  80.                                         {From beginning of program execution}
  81.                   routine : UserProc;   {User procedure to run on expiration}
  82.                   flags   : word;       {Timer status flags}
  83.                   context : word;       {User parameter to pass to User Proc}
  84.                 end;
  85. var
  86.    timers      : array[1..MAX_TIMER] of timer_rec;   {timer database}
  87.    Int1CSave   : pointer;  {dword to hold original Int $1C vector}
  88.    TimeCounter : longint;  {incremented by 55 millisecs on every entry to ISR}
  89.    ExitSave    : pointer;  {Save the address of next unit exit proc in chain}
  90.    i           : integer;  {loop counter}
  91.  
  92. {$F+}
  93. {------------------------------------------------------------------------}
  94. procedure Clock_ISR; interrupt;
  95. {------------------------------------------------------------------------}
  96. { Description:                                                           }
  97. {   This is an interrupt service routine which is hooked into the PC's   }
  98. {   $1C vector.  An Int $1C is generated at each clock tick.  Int $1C is }
  99. {   executed by the hardware interrupt service routine after it has up-  }
  100. {   dated the system time-of-day clock.                                  }
  101. { Parameters:                                                            }
  102. {   None.                                                                }
  103. {------------------------------------------------------------------------}
  104. var
  105.    i : integer;        {local loop counter}
  106. begin
  107.  
  108.   {Update the current time, relative to the start of the program}
  109.  
  110.   inline($FA); {cli}
  111.   TimeCounter := TimeCounter + MILLISECS_PER_TICK; {update millisecond counter}
  112.  
  113.   {Scan the array of timers looking for ones which have expired}
  114.  
  115.   for i := 1 to MAX_TIMER do
  116.     with timers[i] do
  117.       if (flags and TIMER_ALLOCATED) > 0 then   {Is this timer allocated? if no}
  118.         if (flags and TIMER_RUNNING) > 0 then   {Is this timer running? if not}
  119.           if timeout <= TimeCounter then begin  {Has this timer expired yet?}
  120.             flags := flags and (not TIMER_RUNNING); {turn off running flag}
  121.             inline($FB);          {sti}
  122.             routine(context);     {call user expiration routine}
  123.             inline($FA);          {cli}
  124.           end;
  125.   inline($FB); {sti}
  126. end;
  127. {$F-}
  128.  
  129. {------------------------------------------------------------------------}
  130. function AllocateTimer(UserContext : word; UserRtn : UserProc) : integer;
  131. {------------------------------------------------------------------------}
  132. { Description:                                                           }
  133. {   Allocate the next available timer in the timer database for use by   }
  134. {   application.                                                         }
  135. { Parameters:                                                            }
  136. {   UserContext - application specific word of data to be passed to the  }
  137. {                 expiration routine when it is called.                  }
  138. {   UserProc - address of a procedure to be called when the timer expires}
  139. { Returns:                                                               }
  140. {   Handle - integer from 1 to MAX_TIMER                                 }
  141. {            OR -1 if no timers available.                               }
  142. {------------------------------------------------------------------------}
  143. var
  144.    i : integer;
  145. begin
  146.   inline($FA); {cli}
  147.   for i := 1 to MAX_TIMER do begin  {scan timer database looking for 1st free}
  148.     with timers[i] do begin
  149.       if flags = 0 then begin
  150.          flags := TIMER_ALLOCATED;      {Mark timer as allocated}
  151.          context := UserContext;        {Save users context variable}
  152.          routine := UserRtn;            {Store user routine}
  153.          AllocateTimer := i;            {Return handle to timer}
  154.          inline($FB);                   {Enable interrupts}
  155.          exit;
  156.       end;
  157.     end;
  158.   end;
  159.   { No timers available, return error}
  160.   AllocateTimer := -1;
  161.   inline($FB);
  162. end;
  163.  
  164. {------------------------------------------------------------------------}
  165. procedure DeallocateTimer(handle : integer);
  166. {------------------------------------------------------------------------}
  167. { Description:                                                           }
  168. {   Return a previously allocated timer to the pool of available timers  }
  169. {------------------------------------------------------------------------}
  170. begin
  171.   timers[handle].flags := 0;
  172. end;
  173.  
  174.  
  175. {------------------------------------------------------------------------}
  176. procedure StartTimer(handle : integer; rel_timeout : longint);
  177. {------------------------------------------------------------------------}
  178. { Description:                                                           }
  179. {    Start an allocated timer ticking.                                   }
  180. { Parameters:                                                            }
  181. {    Handle - the handle of a previously allocated timer.                }
  182. {    rel_timeout - number of milliseconds before the timer is to expire. }
  183. {------------------------------------------------------------------------}
  184. begin
  185.   inline($FA);  {cli}
  186.   with timers[handle] do begin
  187.     flags := flags or TIMER_RUNNING;       {set timmer running flag}
  188.     timeout := TimeCounter + rel_timeout;  {Convert relative timeout to absolute}
  189.   end;
  190.   inline($FB);  {sti}
  191. end;
  192.  
  193. {------------------------------------------------------------------------}
  194. procedure StopTimer(handle : integer);
  195. {------------------------------------------------------------------------}
  196. { Description:                                                           }
  197. {   Stop a ticking timer from running.  This routine does not deallocate }
  198. {   the timer, just stops it.  Remember, it is possible for the clock    }
  199. {   interrupt to interrupt this routine before it actually stops the     }
  200. {   timer.  Therefore, it is possible for the expiration routine to run  }
  201. {   before the timer is stopped i.e. unexpectedly.                       }
  202. { Parameters:                                                            }
  203. {   Handle - handle of timer to stop.                                    }
  204. {------------------------------------------------------------------------}
  205. begin
  206.   with timers[handle] do
  207.      flags := flags and (not TIMER_RUNNING);
  208. end;
  209.  
  210. {$F+}
  211. {------------------------------------------------------------------------}
  212. Procedure myExitProc;
  213. {------------------------------------------------------------------------}
  214. { Description:                                                           }
  215. {  This is the unit exit procedure which is called as part of a chain of }
  216. {  exit procedures at program termination.                               }
  217. {------------------------------------------------------------------------}
  218. begin
  219.   ExitProc := ExitSave;  {Restore the chain so other units get a turn}
  220.   SetIntVec($1C, Int1CSave);     {restore the original Int $1C vector}
  221. end;
  222. {$F-}
  223.  
  224. {=========================================================================}
  225. {                        INITIALIZATION SECTION                           }
  226. {=========================================================================}
  227.  
  228. Begin {unit initialization code}
  229.  
  230.   (* Establish the unit exit procedure *)
  231.  
  232.   ExitSave := ExitProc;
  233.   ExitProc := @myExitProc;
  234.  
  235.   {Initialize the timers database and install the custom Clock ISR}
  236.  
  237.   for i := 1 to MAX_TIMER do   {clear flag word for all timers}
  238.      timers[i].flags := 0;
  239.   TimeCounter := 0;              {clear current time counter}
  240.   GetIntVec($1C, Int1CSave);     {Save original Int $1C vector}
  241.   SetIntVec($1C, @Clock_ISR);    {install the the clock ISR}
  242. end.
  243.  
  244. {------------------------- End of TIMER.PAS -----------------------------}
  245.  
  246. {---------------------- Beginning of TIMERTST.PAS -----------------------}
  247. program timer_test;
  248.  
  249. uses
  250.     Crt, timer;
  251. var
  252.     t1, t2 : integer; {timer handles}
  253.     done   : boolean;
  254.  
  255. {---- Procedure to be run when timer 1 expires ----}
  256. procedure t1_proc(context1 : word); far;
  257. begin
  258.   writeln('Timer ',context1);
  259.   StartTimer(t1, 1000);        {Keep timer 1 running}
  260. end;
  261.  
  262. {---- Procedure to be run when timer 2 expires ----}
  263. procedure t2_proc(context2 : word); far;
  264. begin
  265.   done := true;
  266.   writeln('Timer ',context2,' expired');
  267. end;
  268.  
  269. begin
  270.   ClrScr;
  271.   done := false;
  272.   t1 := AllocateTimer(1, t1_proc);        {Create timer 1}
  273.   t2 := AllocateTimer(2, t2_proc);        {Create timer 2}
  274.   StartTimer(t2, 5000);        {Start timer 2 for 5 second delay}
  275.   StartTimer(t1, 1000);        {Start timer 1 for 1 second delay}
  276.   while not done do begin      {Do nothing until timer 2 expires}
  277.      end;
  278.   StopTimer(t1);
  279. end.
  280.